﻿module UnfoldMonad

open System
open System.Collections.Generic
open System.Linq
open System.Text.RegularExpressions
open Microsoft.FSharp.Collections
open Microsoft.Xna.Framework
open Microsoft.Xna.Framework.Audio
open Microsoft.Xna.Framework.Content
open Microsoft.Xna.Framework.GamerServices
open Microsoft.Xna.Framework.Graphics
open Microsoft.Xna.Framework.Input
open Microsoft.Xna.Framework.Media
open EntitiesAndGameState
open Component
open Utils

type Unfold<'a,'s,'r> = ('s * 'r * Time * Time) -> Step<'a,'s,'r>
and Step<'a,'s,'r> = Done of 'a | Next of Unfold<'a,'s,'r>

type GameResult = Defeat | Victory

type UnfoldBuilder<'s,'r>() =
  member this.Delay f = f()
  member this.Return(x:'a) : Unfold<'a,'s,'r> =
    fun s -> Done x
  member this.Bind(p:Unfold<'a,'s,'r>,k:'a->Unfold<'b,'s,'r>):Unfold<'b,'s,'r> =
    fun s ->
      match p s with
      | Done x -> Next(k x)
      | Next p' -> Next(this.Bind(p',k))
  member this.Combine(p:Unfold<Unit,'s,'r>,r:Unfold<'b,'s,'r>):Unfold<'b,'s,'r> =
    fun s ->
      match p s with
      | Done x -> Next(r)
      | Next p' -> Next(this.Combine(p',r))
  member this.For(items:seq<'a>, body:'a -> Unfold<Unit,'s,'r>) : Unfold<Unit,'s,'r> =
    fun s ->
      if items |> Seq.length = 0 then 
        Done()
      else
        let hd,tl = items |> Seq.head, items |> Seq.skip 1
        Next(this.Combine(body hd, this.For(tl, body)))
  member this.While(cond : Unit -> bool, body:Unfold<Unit,'s,'r>) : Unfold<Unit,'s,'r> =
    fun s ->
      if cond() then
        match body s with
        | Done() -> Next(this.While(cond,body))
        | Next body' -> Next(this.Combine(body',this.While(cond, body)))
      else 
        Done()
  member this.Zero() = this.Return()
  member this.ReturnFrom p = p

type RenderState = { mutable Text : (string * Vector2 * Vector2 * Color) option;
                     mutable Texture : (string * Vector2 * Vector2 * Color) option }
type GameState = IStateProvider<BaseLevelStats>

type Script<'a> = Unfold<'a,GameState,RenderState>

let unfold = UnfoldBuilder<GameState,RenderState>()

let set_render_texture texture p c s : Script<Unit> = 
  fun (_,r, rt, gt) -> Done(r.Texture <- Some (texture,p,s,c))

let remove_render_texture : Script<Unit> =
  fun (s,r, rt, gt) -> Done(r.Texture <- None)

let set_render_text text p c s : Script<Unit> = 
  fun (_,r, rt, gt) -> Done(r.Text <- Some (text,p,s,c))

let get_render_text : Script<_> = 
  fun (_,r, rt, gt) -> 
    match r.Text with
    | None -> Done ""
    | Some (t,_,_,_) -> Done t

let remove_render_text : Script<Unit> = 
  fun (s,r, rt, gt) -> Done(r.Text <- None)

type AnimationState = Entering of float32 | Entered | Exiting of float32 | NoAnimation

let prova2 = 2

let mk_script (game:Game) (sprite_batch:SpriteBatch)
              (script:Script<GameResult>) (game_state:GameState) 
              (game_result:GameResult option ref)
              current_game_time =

  let animation = ref NoAnimation
  let animation_time = 0.3f
  let current_time = ref { T = 0.0f; DT = 0.0f }

  do game_result := None
  let screen_size = Vector2((float32 game.GraphicsDevice.Viewport.Width),
                            (float32 game.GraphicsDevice.Viewport.Height))
  let renderer = {Text = None; Texture = None}
  let script = ref script
  let update (gt:GameTime) = 
    let dt = gt.ElapsedGameTime.TotalSeconds|> float32
    current_time := {T = current_time.Value.T + dt; DT = dt}
    script := match script.Value (game_state,renderer,!current_time,!current_game_time) with
              | Done res -> 
                game_result := Some res
                (fun _ -> Done res)
              | Next s' -> s'
  let draw (gt:GameTime) =
      sprite_batch.Begin(SpriteSortMode.Immediate,
              BlendState.AlphaBlend, SamplerState.LinearClamp, 
              DepthStencilState.None, null, null, 
              Matrix.CreateScale(screen_size.X / 100.0f,
                                  screen_size.Y / 100.0f, 1.0f))

      let draw_string_centered (f:SpriteFont) (t:String) (p:Vector2) (c:Color) (s:Vector2) =
        let t_size = f.MeasureString(t)
        let t_center = t_size * 0.5f
        let scale = 100.0f / screen_size.X // min (s.X / t_size.X) 1.0f
        sprite_batch.DrawString(f, t, p, c, 0.0f, t_center, scale * 0.9f, SpriteEffects.None, 0.0f)
    
      match renderer.Text with
      | Some(t,p,s,c) -> 
        let r = Rectangle((p.X - s.X * 0.5f) |> int, (p.Y - s.Y * 0.5f) |> int, 
                          (s.X) |> int, (s.Y) |> int)
        sprite_batch.Draw(game.Content.Load(@"textbar"), r, Color.Black)
        draw_string_centered (game.Content.Load("font")) t p c s
      | _ -> ()

      match renderer.Texture with
      | Some(t,p,s,c) -> 
        let r = Rectangle((p.X - s.X * 0.5f) |> int, (p.Y - s.Y * 0.5f) |> int, 
                          (s.X) |> int, (s.Y) |> int)
        sprite_batch.Draw(game.Content.Load(t), r, Color.White)
      | _ -> ()

      sprite_batch.End()

  { update = update; draw = draw }

let time (c,n,rt,gt) = Done rt

let wait max_dt =
  let rec wait t0 =
    unfold{
      let! t = time
      let dt = t.T - t0.T
      if dt < max_dt then
        return! wait t0
    }
  unfold {
    let! t0 = time
    return! wait t0
  }
let wait_and_print_step max_dt dt_step msg (color:RGB) text_center text_size =
  let rec aux_wait t0 =
    unfold{
      let! t = time
      let dt = t.T - t0.T
      do! set_render_text (msg+" "+(int (max_dt - dt)).ToString()) text_center color.ToColor text_size
      if dt < max_dt then
        do! wait (min (max_dt - dt) dt_step)
        return! aux_wait t0
    }
  unfold {
    let! t0 = time
    return! aux_wait t0
  }
let wait_and_print max_dt msg (color:RGB) text_center text_size =
  let rec wait t0 =
    unfold{
      let! t = time      
      let dt = t.T - t0.T
      do! set_render_text (msg+" "+(int (max_dt - dt)).ToString()) text_center color.ToColor text_size
      if dt < max_dt then
        return! wait t0
    }
  unfold {
    let! t0 = time
    return! wait t0
  }
let wait_and_print_without_time max_dt msg (color:RGB) text_center text_size =
  let rec wait t0 =
    unfold{
      let! t = time      
      let dt = t.T - t0.T
      do! set_render_text msg text_center color.ToColor text_size
      if dt < max_dt then
        return! wait t0
    }
  unfold {
    let! t0 = time
    return! wait t0
  }

let rec forever_ (s : Unfold<Unit,_,_>) : Unfold<Unit,_,_> =
  unfold{
    do! s
    return! forever_ s
  }

//let pause : Script<_> = 
//  fun (s,_,_,_) -> Done(s. <- true)

//let start_skippable_dialog : Script<_> = 
//  fun (s,_,_,_) -> Done(s.GameState.SkippableDalog <- true)
//
//let end_skippable_dialog : Script<_> = 
//  fun (s,_,_,_) -> Done(s.GameState.SkippableDalog <- false)
//
//let resume : Script<_> = 
//  fun (s,_,_,_) -> Done(s.GameState.Paused <- false)

let rec while_ (c : Script<bool>) (b:Script<Unit>) : Script<Unit> =
  unfold{
    let! c_v = c
    if c_v then
      do! b
      return! while_ c b
    else
      return ()
  }

let ignore_ (p:Script<'a>) : Script<Unit> =
  unfold{
    let! _ = p
    return ()
  }

let rec parallel_ (p:Script<'a>) (r:Script<'b>) : Script<'a * 'b> =
  fun s ->
    match p s, r s with
    | Done x, Done y -> Done(x,y)
    | Next p', Next r' -> Next(parallel_ p' r')
    | Next p', Done y -> Next(parallel_ p' (unfold.Return(y)))
    | Done x, Next r' -> Next(parallel_ (unfold.Return(x)) r')

let rec parallel_many_ = 
  function
  | [] -> unfold{return ()}
  | (t:Script<'a>) :: (ts:Script<'a> list) -> parallel_ t (parallel_many_ ts) |> ignore_

type Either<' a,' b> = Left of ' a | Right of ' b
let rec parallel_first_ (p:Script<'a>) (r:Script<'b>) : Script<Either<'a, 'b>> =
  fun s ->
    match p s, r s with
    | Done x, _ -> Done(Left x)
    | _, Done y -> Done(Right y)
    | Next p', Next r' -> Next(parallel_first_ p' r')

let rec atomic_ (p:Script<'a>) : Script<'a> =
  fun s ->
    match p s with
    | Done x -> Done x 
    | Next p' -> atomic_ p' s

let not_ (p:Script<bool>) : Script<bool> =
  unfold{
    let! res = p
    return res |> not
  }

let and_ (a:Script<bool>) (b:Script<bool>) : Script<bool> =
  unfold{
    let! a = a
    let! b = b
    return a && b
  }

let or_ (a:Script<bool>) (b:Script<bool>) : Script<bool> =
  unfold{
    let! a = a
    let! b = b
    return a || b
  }

let rec run_ (p:Script<'a>) =
  fun s ->
    match p s with
    | Done x -> x 
    | Next p' -> run_ p' s

let wait_while_ c = while_ c (unfold{ return () })

let show_for t p c s dt =
  unfold{
    do! set_render_text t p c s
    do! wait dt
    do! remove_render_text    
  }

let iter_ f l =
  unfold{
    for x in l do f x
  }

let rec set_render_texts (msgLst:string list) (interval:float32) text_center color text_size =
  unfold{
//    do! pause
//    do! start_skippable_dialog
    match msgLst with
    |[] -> ()
//      do! resume
//      do! end_skippable_dialog
    |msg::lst -> ()
//      do! set_render_text msg text_center color text_size
//      let num_words = (msg.Split [|' '; '\n'|]).Length |> float32
//      let do_not_skip =
//        fun _ -> Done(Keyboard.GetState().[Keys.Space] = KeyState.Up &&
//                      Mouse.GetState().LeftButton = ButtonState.Released &&
//                      GamePad.GetState(PlayerIndex.One).Buttons.A = ButtonState.Released)
//      do! (parallel_first_
//            (wait (interval + 1.0f * num_words))
//            (unfold{
//                do! wait_while_ do_not_skip
//                do! wait 0.1f
//              })) |> ignore_
//      do! set_render_texts lst interval text_center color text_size
  }
